# TODO:
# -[] clean code
# -[] predicted value plots for E and F
# -[] webshot::install_phantomjs() in make install
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.6 ✓ dplyr 1.0.8
## ✓ tidyr 1.2.0 ✓ stringr 1.4.0
## ✓ readr 2.1.2 ✓ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
theme_set(theme_minimal())
library(broom)
library(patchwork)
library(ggbeeswarm)
library(dagitty)
library(ggdag)
##
## Attaching package: 'ggdag'
## The following object is masked from 'package:stats':
##
## filter
## <https://cran.r-project.org/web/packages/ggdag/vignettes/intro-to-ggdag.html>
library(gt)
library(gtsummary)
## Need Hmisc for bootstrap CIs in some plots, but don't want to load it
find.package('Hmisc')
## [1] "/Users/danhicks/Library/Caches/org.R-project.R/R/renv/library/transparency-b4b6f02c/R-4.1/x86_64-apple-darwin17.0/Hmisc"
library(here)
## here() starts at /Users/danhicks/Google Drive/Writing/transparency
source(here('R', 'reg_tbl.R'))
source(here('R', 'plot_adjustments.R'))
source(here('R', 'reg_plots.R'))
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
## The following object is masked from 'package:purrr':
##
## some
options(contrasts = c('contr.Treatment', 'contr.poly'))
options(decorate.contr.Treatment = '')
out_dir = here('out')
if (!dir.exists(out_dir)) {
dir.create(out_dir)
}
data_dir = here('data')
## Load data ----
## Elliott et al. data
emad_df = read_rds(here(data_dir, 'emad.Rds'))
## Our data
dataf = read_rds(here(data_dir, 'data.Rds'))
## Descriptive summary of our data ----
## - age
## - gender
## - race/ethnicity
## - <https://www.census.gov/library/visualizations/interactive/race-and-ethnicity-in-the-united-state-2010-and-2020-census.html>
## - overrep White (72% vs. 62%)
## - underrep Hispanic (3% vs. 19%)
## - Black and A/PI represented accurately at 13% and 6%
## - religious affiliation
## - religious services
## - political ideology
## - political affiliation
## - education
## - <https://www.statista.com/statistics/184260/educational-attainment-in-the-us/>
## - underrep non-HS grads (1% vs. 9%)
## - overrep college grads (57% vs. 38%)
## - participant values
re_labels = c('American Indian or Alaskan Native',
'Asian or Pacific Islander',
'Black',
'Hispanic',
'White',
'Other',
'Prefer not to answer')
relig_labels = c('Buddhist',
'Catholic',
'Hindu',
'Jewish',
'Muslim',
'Protestant',
'No religion',
'Other', 'Prefer not to answer')
relig_serv_labels = c('Never',
'A few times per year',
'Once every month or two',
'2-3 times per month',
'Once per week',
'More than once per week',
'Daily')
poli_id_labels = c('Strongly liberal',
'Moderately liberal',
'Mildly liberal',
'Centrist',
'Mildly conservative',
'Moderately conservative',
'Strongly conservative',
'Other',
'Prefer not to answer')
poli_aff_labels = c('Democratic party',
'Republican party',
'Independent/no party',
'Other',
'Prefer not to answer')
edu_labels = c('Less than high school',
'High school, or some college',
'Bachelor’s degree or higher')
fix_multifac = function(vec, labs, ordered = FALSE) {
chr = vec |>
as.character() |>
str_split(',') |>
map(~ labs[as.integer(.x)]) |>
map_chr(str_c, collapse = '/')
if (!ordered) {
return(chr)
} else {
fct_relevel(chr, labs)
}
}
demo_gt = dataf |>
select(pid, age, gender, race_ethnicity,
religious_affil, religious_serv,
political_ideology, political_affiliation,
education, part_values, disclosure) |>
mutate(gender = fct_drop(gender),
race_ethnicity = fix_multifac(race_ethnicity, re_labels),
religious_affil = fix_multifac(religious_affil, relig_labels),
religious_serv = fix_multifac(religious_serv, relig_serv_labels,
ordered = TRUE),
political_ideology = fix_multifac(political_ideology, poli_id_labels,
ordered = TRUE),
political_affiliation = fix_multifac(political_affiliation,
poli_aff_labels),
education = fix_multifac(education, edu_labels, ordered = TRUE)) |>
select(-pid) |>
tbl_summary(label = list(race_ethnicity ~ 'race/ethnicity',
religious_affil ~ 'religious affiliation',
religious_serv ~ 'religious service attendance',
political_ideology ~ 'political ideology',
political_affiliation ~ 'political affiliation',
part_values ~ 'participant values'),
sort = list(race_ethnicity ~ 'frequency',
religious_affil ~ 'frequency')) |>
bold_labels()
## Warning: Unknown levels in `f`: Other, Prefer not to answer
demo_gt |>
as_flex_table() |>
flextable::save_as_docx(path = here(out_dir, '03_demo_table.docx'),
pr_section = officer::prop_section(page_size = officer::page_size(orient = "landscape")))
## Trust, overall ----
ggplot() +
geom_violin(aes(x = 'EMAD', pa_mean),
draw_quantiles = .5,
data = emad_df) +
geom_beeswarm(aes(x = 'EMAD', pa_mean),
data = emad_df) +
geom_violin(aes(x = 'HL', meti_mean),
draw_quantiles = .5,
data = dataf) +
geom_beeswarm(aes(x = 'HL', meti_mean),
data = dataf) +
ylab('mean trust')
Across our dataset, standard deviation of mean trust. Use one-third of this as meaningful.
sd(dataf$meti_mean)
## [1] 1.288985
meaningful = sd(dataf$meti_mean)/3
meaningful
## [1] 0.4296617
## A. Modest correlation between values and ideology ----
(i) Political liberals are more likely to prioritize public health over economic growth, compared to political conservatives; but (ii) a majority of political conservatives prioritize public health.
NB 1. No DAG here because this isn’t a causal claim. 2. Direction of ideology coding is reversed between the two studies.
Compared to Elliott et al., our strong conservatives placed lower value on public health, and overall conservatives are about 50-50.
emad_df |>
count(ideology, tradeoff) |>
group_by(ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(ideology, n, fill = as.factor(tradeoff))) +
geom_col() +
scale_fill_viridis_d()
last_plot() + aes(y = share)
part_values_plot = dataf |>
filter(!is.na(pref)) |>
count(political_ideology, part_values) |>
group_by(political_ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(political_ideology, n, fill = part_values)) +
geom_col(color = 'black') +
scale_x_continuous(labels = NULL,
name = '← liberal conservative →\npolitical ideology') +
scale_fill_viridis_d(option = 'E', name = 'participant\nvalues')
part_values_plot
## Warning: Removed 2 rows containing missing values (position_stack).
part_values_share = part_values_plot + aes(y = share) +
scale_y_continuous(labels = scales::percent_format())
part_values_share
## Warning: Removed 2 rows containing missing values (position_stack).
part_values_plot + part_values_share +
plot_layout(guides = 'collect') +
plot_annotation(tag_levels = 'A')
## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).
ggsave(here(out_dir, '03_part_values.png'),
height = 4, width = 8, dpi = 200, scale = 1.5)
## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).
table(dataf$political_ideology, dataf$pref)
##
## 1 2 3 4
## 1 5 1 18 133
## 2 9 13 47 135
## 3 5 14 44 66
## 4 16 19 31 39
## 5 13 18 22 27
## 6 22 27 18 25
## 7 19 9 3 6
dataf |>
mutate(political_ideology = case_when(
political_ideology < 4 ~ 'liberal',
political_ideology == 4 ~ 'moderate',
political_ideology > 4 ~ 'conservative'
)) |>
count(political_ideology)
## # A tibble: 4 × 2
## political_ideology n
## <chr> <int>
## 1 conservative 248
## 2 liberal 574
## 3 moderate 118
## 4 <NA> 48
cor(emad_df$ideology, emad_df$tradeoff,
use = 'complete.obs',
method = 'spearman')
## [1] 0.2717778
cor(as.integer(dataf$political_ideology), as.integer(dataf$pref),
use = 'complete.obs',
method = 'spearman')
## [1] -0.4712353
glm(I(part_values == 'economic growth') ~ political_ideology,
family = 'binomial',
data = dataf) |>
summary()
##
## Call:
## glm(formula = I(part_values == "economic growth") ~ political_ideology,
## family = "binomial", data = dataf)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5838 -0.6027 -0.4484 -0.3306 2.4225
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.51269 0.24200 -14.52 <2e-16 ***
## political_ideology 0.63300 0.05455 11.61 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 879.25 on 803 degrees of freedom
## Residual deviance: 711.42 on 802 degrees of freedom
## (184 observations deleted due to missingness)
## AIC: 715.42
##
## Number of Fisher Scoring iterations: 5
## DAG ----
We use the following DAG throughout the rest of this analysis
dag = dagify(METI ~ shared_values + sci_values +
part_values + demographics,
shared_values ~ part_values + sci_values,
part_values ~ demographics,
outcome = 'METI') |>
tidy_dagitty(layout = 'kk')
ggplot(dag, aes(x = x, y = y,
xend = xend, yend = yend)) +
geom_label(aes(label = name)) +
geom_dag_edges() +
coord_cartesian(clip = 'off') +
theme_dag()
## B. Consumer risk sensitivity ----
Scientists who find that a chemical harms human health are perceived as more trustworthy than scientists who find that a chemical does not cause harm.
ggplot(emad_df, aes(conclusion, pa_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
ggplot(dataf, aes(conclusion, meti_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
Because the conclusion is experimentally manipulated, we don’t need any adjustments.
dag |>
add_arrows('conclusion -> METI') |>
plot_adjustments(exposure = 'conclusion') +
scale_color_manual(values = 'black')
model_b_emad = lm(pa_mean ~ conclusion, data = emad_df)
summary(model_b_emad)
##
## Call:
## lm(formula = pa_mean ~ conclusion, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.6131 -0.8536 0.1012 1.1464 2.4321
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.61306 0.08953 62.693 < 2e-16 ***
## conclusion[does not cause harm] -1.04516 0.12415 -8.418 4.12e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.384 on 496 degrees of freedom
## Multiple R-squared: 0.125, Adjusted R-squared: 0.1233
## F-statistic: 70.87 on 1 and 496 DF, p-value: 4.121e-16
model_b = lm(meti_mean ~ conclusion, data = dataf)
summary(model_b)
##
## Call:
## lm(formula = meti_mean ~ conclusion, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8315 -0.7601 0.0256 0.8730 2.5158
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.47437 0.05346 102.40 <2e-16 ***
## conclusion[does not cause harm] -0.99019 0.07576 -13.07 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.191 on 986 degrees of freedom
## Multiple R-squared: 0.1477, Adjusted R-squared: 0.1468
## F-statistic: 170.8 on 1 and 986 DF, p-value: < 2.2e-16
plot_residuals(model_b)
## `geom_smooth()` using formula 'y ~ x'
plot_estimate(list(emad = model_b_emad,
hl = model_b),
str_detect(term, 'conclusion'))
tbl_regression(model_b, intercept = TRUE) |>
add_glance_table(include = c(r.squared, nobs, statistic, p.value))
| Characteristic | Beta | 95% CI1 | p-value |
|---|---|---|---|
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | |||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.148 | ||
| No. Obs. | 988 | ||
| Statistic | 171 | ||
| p-value | <0.001 | ||
| 1 CI = Confidence Interval | |||
list(emad = model_b_emad,
hl = model_b) |>
reg_tbl()
| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.6 | 5.4, 5.8 | <0.001 | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.3, -0.80 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.125 | 0.148 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.123 | 0.147 | ||||
| Statistic | 70.9 | 171 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
## C. Transparency penalty ----
Scientists who disclose values are perceived as less trustworthy than scientists who do not.
{
trans_plot_emad = ggplot(emad_df, aes(disclosure, pa_mean)) +
# geom_violin(draw_quantiles = .5) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_emad
trans_plot_us = ggplot(dataf, aes(disclosure, meti_mean)) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_us
trans_plot_emad +
ggtitle('EMAD') +
trans_plot_us +
ggtitle('HL replication')
ggsave(here(out_dir, '03_transparency.png'),
height = 3, width = 6, scale = 1,
bg = 'white')
}
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
Again, disclosure/transparency is experimentally controlled, so no adjustment is required.
dag |>
add_arrows('disclose -> METI') |>
plot_adjustments('disclose') +
scale_color_manual(values = 'black')
model_c_emad = lm(pa_mean ~ disclosure, data = emad_df)
summary(model_c_emad)
##
## Call:
## lm(formula = pa_mean ~ disclosure, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3917 -0.9519 0.1798 1.2231 2.0802
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.3917 0.1164 46.316 < 2e-16 ***
## disclosure[TRUE] -0.4719 0.1409 -3.349 0.000871 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.463 on 496 degrees of freedom
## Multiple R-squared: 0.02212, Adjusted R-squared: 0.02015
## F-statistic: 11.22 on 1 and 496 DF, p-value: 0.0008714
model_c = lm(meti_mean ~ disclosure, data = dataf)
summary(model_c)
##
## Call:
## lm(formula = meti_mean ~ disclosure, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9447 -0.9120 0.0880 0.9839 2.0553
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.05488 0.07115 71.045 <2e-16 ***
## disclosure[TRUE] -0.11018 0.08705 -1.266 0.206
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.289 on 986 degrees of freedom
## Multiple R-squared: 0.001622, Adjusted R-squared: 0.0006095
## F-statistic: 1.602 on 1 and 986 DF, p-value: 0.2059
plot_residuals(model_c)
## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_c, 'disclosure')
plot_estimate(list(emad = model_c_emad,
hl = model_c),
str_detect(term, 'disclosure'))
list(emad = model_c_emad,
hl = model_c) |>
reg_tbl()
| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.4 | 5.2, 5.6 | <0.001 | 5.1 | 4.9, 5.2 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.47 | -0.75, -0.20 | <0.001 | -0.11 | -0.28, 0.06 | 0.2 |
| R² | 0.022 | 0.002 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.020 | 0.001 | ||||
| Statistic | 11.2 | 1.60 | ||||
| p-value | <0.001 | 0.2 | ||||
| 1 CI = Confidence Interval | ||||||
## B + C combined table ----
model_bc_emad = lm(pa_mean ~ conclusion + disclosure, data = emad_df)
model_bc = lm(meti_mean ~ conclusion + disclosure, data = dataf)
bc_tbl = list(emad = model_bc_emad,
hl = model_bc) |>
reg_tbl()
bc_tbl
| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 6.0 | 5.7, 6.2 | <0.001 | 5.6 | 5.4, 5.7 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.1 | -1.3, -0.82 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.52 | -0.78, -0.26 | <0.001 | -0.12 | -0.28, 0.04 | 0.14 |
| R² | 0.152 | 0.150 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.148 | 0.148 | ||||
| Statistic | 44.3 | 86.6 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
write_reg_tbl(bc_tbl, here(out_dir, '03_bc_tbl'))
## D. Shared values ----
The magnitude of the effects above vary depending on whether the participant prioritizes public health or economic growth.
For B and C, bringing in participant values introduces a potential
back-door path through demographics. This is very similar to D.
Fortunately, as also with D, we just need to control
part_values (and conclusion).
dag |>
add_arrows(c('part_values -> conclusion_x_part_values <- conclusion',
'conclusion_x_part_values -> METI <- conclusion')) |>
plot_adjustments('conclusion_x_part_values')
model_eb_emad = lm(pa_mean ~ conclusion*part_values, data = emad_df)
summary(model_eb_emad)
##
## Call:
## lm(formula = pa_mean ~ conclusion * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.7437 -0.8610 0.1599 1.0251 2.5965
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.4116 0.1417
## conclusion[does not cause harm] -0.5505 0.2026
## part_values[public health] 0.3321 0.1819
## conclusion[does not cause harm]:part_values[public health] -0.7897 0.2557
## t value Pr(>|t|)
## (Intercept) 38.189 < 2e-16 ***
## conclusion[does not cause harm] -2.717 0.00682 **
## part_values[public health] 1.826 0.06853 .
## conclusion[does not cause harm]:part_values[public health] -3.089 0.00213 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.374 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.1429, Adjusted R-squared: 0.1377
## F-statistic: 27.35 on 3 and 492 DF, p-value: 2.243e-16
model_eb = lm(meti_mean ~ conclusion*part_values, data = dataf)
summary(model_eb)
##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9199 -0.7056 0.0087 0.8658 2.6042
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.3876 0.1131
## conclusion[does not cause harm] -0.7541 0.1673
## part_values[public health] 0.1752 0.1312
## conclusion[does not cause harm]:part_values[public health] -0.4128 0.1912
## t value Pr(>|t|)
## (Intercept) 47.632 < 2e-16 ***
## conclusion[does not cause harm] -4.509 7.45e-06 ***
## part_values[public health] 1.335 0.1823
## conclusion[does not cause harm]:part_values[public health] -2.159 0.0311 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.175 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.1763, Adjusted R-squared: 0.1734
## F-statistic: 59.95 on 3 and 840 DF, p-value: < 2.2e-16
plot_residuals(model_eb)
## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_eb, ':')
# plot_estimate(list(emad = model_eb_emad,
# hl = model_eb),
# str_detect(term, ':'))
plot_predictions(model_eb, c('conclusion', 'part_values'),
interaction_ci = TRUE)
plot_estimate(list(base = model_b, interaction = model_eb),
str_detect(term, 'conclusion'))
list(base = model_b, interaction = model_eb) |>
reg_tbl(labs = c('base', 'interaction'))
| Characteristic | base | interaction | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 |
| part_values | ||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | |||
| conclusion * part_values | ||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | |||
| R² | 0.148 | 0.176 | ||||
| No. Obs. | 988 | 844 | ||||
| Adjusted R² | 0.147 | 0.173 | ||||
| Statistic | 171 | 59.9 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
Again, include demographics as a check
model_eb1 = lm(meti_mean ~ conclusion*part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
summary(model_eb1)
##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values + age + gender +
## race_ethnicity + religious_affil + religious_serv + political_ideology +
## education, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.703 -0.689 0.000 0.815 2.839
##
## Coefficients: (1 not defined because of singularities)
## Estimate
## (Intercept) 5.269896
## conclusion[does not cause harm] -0.725321
## part_values[public health] 0.199800
## age 0.002336
## gender[Man/Male.Man/Male] 0.061406
## gender[Man/Male.Woman/Female] 0.668535
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -1.420756
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.319357
## gender[Woman/Female.Man/Male] -0.811087
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.813567
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.510207
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.197609
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.392368
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.803310
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.415886
## gender[Woman/Female.Woman/Female & Man/Male] 1.022698
## race_ethnicity[3] 0.169188
## race_ethnicity[2] 0.008730
## race_ethnicity[4] 0.296248
## race_ethnicity[2,5] -0.344107
## race_ethnicity[4,5] 0.235121
## race_ethnicity[1,5] -0.186294
## race_ethnicity[3,5] 0.620084
## race_ethnicity[1] 0.247225
## race_ethnicity[6] 0.134925
## race_ethnicity[3,4] 0.542722
## race_ethnicity[1,3] 0.652296
## race_ethnicity[1,3,5] 1.425109
## race_ethnicity[1,4,5] -0.506392
## race_ethnicity[2,4,5] 0.910759
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.774866
## religious_affil[6] 0.266205
## religious_affil[2] 0.145139
## religious_affil[8] 0.491350
## religious_affil[9] 0.024232
## religious_affil[4] 0.647875
## religious_affil[1] 0.366487
## religious_affil[5] 0.671171
## religious_affil[3] 0.081191
## religious_affil[7,8] 0.570199
## religious_affil[1,2] 0.535704
## religious_affil[1,6] -0.854535
## religious_affil[1,7] 0.481840
## religious_affil[2,7] 0.009369
## religious_affil[4,7] 0.682151
## religious_affil[6,9] 1.667394
## religious_affil[8,9] 1.191154
## religious_serv -0.014953
## political_ideology -0.022497
## education -0.043906
## conclusion[does not cause harm]:part_values[public health] -0.463876
## Std. Error
## (Intercept) 0.297492
## conclusion[does not cause harm] 0.176724
## part_values[public health] 0.148537
## age 0.002882
## gender[Man/Male.Man/Male] 0.087234
## gender[Man/Male.Woman/Female] 0.834456
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.682826
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.623232
## gender[Woman/Female.Man/Male] 0.593137
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 1.169456
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.876076
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.183602
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.168886
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 1.170160
## gender[Man/Male.Indigenous or other cultural gender minority identity] 1.229431
## gender[Woman/Female.Woman/Female & Man/Male] 1.181591
## race_ethnicity[3] 0.133069
## race_ethnicity[2] 0.192705
## race_ethnicity[4] 0.245233
## race_ethnicity[2,5] 0.399441
## race_ethnicity[4,5] 0.481519
## race_ethnicity[1,5] 0.559966
## race_ethnicity[3,5] 0.485083
## race_ethnicity[1] 0.589822
## race_ethnicity[6] 0.606086
## race_ethnicity[3,4] 0.711323
## race_ethnicity[1,3] 1.187150
## race_ethnicity[1,3,5] 1.171498
## race_ethnicity[1,4,5] 1.170419
## race_ethnicity[2,4,5] 1.175382
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 1.291521
## religious_affil[6] 0.130309
## religious_affil[2] 0.156570
## religious_affil[8] 0.167107
## religious_affil[9] 0.233107
## religious_affil[4] 0.289311
## religious_affil[1] 0.368428
## religious_affil[5] 0.499712
## religious_affil[3] 0.514410
## religious_affil[7,8] 0.830187
## religious_affil[1,2] 1.191750
## religious_affil[1,6] 1.168884
## religious_affil[1,7] 1.185778
## religious_affil[2,7] 1.173376
## religious_affil[4,7] 1.168637
## religious_affil[6,9] 1.169145
## religious_affil[8,9] 1.664191
## religious_serv 0.035004
## political_ideology 0.028822
## education 0.086157
## conclusion[does not cause harm]:part_values[public health] 0.202327
## t value
## (Intercept) 17.714
## conclusion[does not cause harm] -4.104
## part_values[public health] 1.345
## age 0.811
## gender[Man/Male.Man/Male] 0.704
## gender[Man/Male.Woman/Female] 0.801
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -2.081
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -2.117
## gender[Woman/Female.Man/Male] -1.367
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.551
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.582
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.012
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.191
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.686
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.152
## gender[Woman/Female.Woman/Female & Man/Male] 0.866
## race_ethnicity[3] 1.271
## race_ethnicity[2] 0.045
## race_ethnicity[4] 1.208
## race_ethnicity[2,5] -0.861
## race_ethnicity[4,5] 0.488
## race_ethnicity[1,5] -0.333
## race_ethnicity[3,5] 1.278
## race_ethnicity[1] 0.419
## race_ethnicity[6] 0.223
## race_ethnicity[3,4] 0.763
## race_ethnicity[1,3] 0.549
## race_ethnicity[1,3,5] 1.216
## race_ethnicity[1,4,5] -0.433
## race_ethnicity[2,4,5] 0.775
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.374
## religious_affil[6] 2.043
## religious_affil[2] 0.927
## religious_affil[8] 2.940
## religious_affil[9] 0.104
## religious_affil[4] 2.239
## religious_affil[1] 0.995
## religious_affil[5] 1.343
## religious_affil[3] 0.158
## religious_affil[7,8] 0.687
## religious_affil[1,2] 0.450
## religious_affil[1,6] -0.731
## religious_affil[1,7] 0.406
## religious_affil[2,7] 0.008
## religious_affil[4,7] 0.584
## religious_affil[6,9] 1.426
## religious_affil[8,9] 0.716
## religious_serv -0.427
## political_ideology -0.781
## education -0.510
## conclusion[does not cause harm]:part_values[public health] -2.293
## Pr(>|t|)
## (Intercept) < 2e-16
## conclusion[does not cause harm] 4.5e-05
## part_values[public health] 0.17899
## age 0.41789
## gender[Man/Male.Man/Male] 0.48170
## gender[Man/Male.Woman/Female] 0.42329
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.03780
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.03459
## gender[Woman/Female.Man/Male] 0.17189
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.12138
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.56049
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 0.31194
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 0.23396
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.49261
## gender[Man/Male.Indigenous or other cultural gender minority identity] 0.24983
## gender[Woman/Female.Woman/Female & Man/Male] 0.38703
## race_ethnicity[3] 0.20397
## race_ethnicity[2] 0.96388
## race_ethnicity[4] 0.22742
## race_ethnicity[2,5] 0.38925
## race_ethnicity[4,5] 0.62549
## race_ethnicity[1,5] 0.73946
## race_ethnicity[3,5] 0.20154
## race_ethnicity[1] 0.67523
## race_ethnicity[6] 0.82389
## race_ethnicity[3,4] 0.44572
## race_ethnicity[1,3] 0.58285
## race_ethnicity[1,3,5] 0.22418
## race_ethnicity[1,4,5] 0.66539
## race_ethnicity[2,4,5] 0.43867
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 0.16978
## religious_affil[6] 0.04141
## religious_affil[2] 0.35423
## religious_affil[8] 0.00338
## religious_affil[9] 0.91724
## religious_affil[4] 0.02542
## religious_affil[1] 0.32019
## religious_affil[5] 0.17964
## religious_affil[3] 0.87463
## religious_affil[7,8] 0.49240
## religious_affil[1,2] 0.65319
## religious_affil[1,6] 0.46497
## religious_affil[1,7] 0.68460
## religious_affil[2,7] 0.99363
## religious_affil[4,7] 0.55959
## religious_affil[6,9] 0.15424
## religious_affil[8,9] 0.47436
## religious_serv 0.66937
## political_ideology 0.43532
## education 0.61048
## conclusion[does not cause harm]:part_values[public health] 0.02214
##
## (Intercept) ***
## conclusion[does not cause harm] ***
## part_values[public health]
## age
## gender[Man/Male.Man/Male]
## gender[Man/Male.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] *
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] *
## gender[Woman/Female.Man/Male]
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]
## gender[Man/Male.Indigenous or other cultural gender minority identity]
## gender[Woman/Female.Woman/Female & Man/Male]
## race_ethnicity[3]
## race_ethnicity[2]
## race_ethnicity[4]
## race_ethnicity[2,5]
## race_ethnicity[4,5]
## race_ethnicity[1,5]
## race_ethnicity[3,5]
## race_ethnicity[1]
## race_ethnicity[6]
## race_ethnicity[3,4]
## race_ethnicity[1,3]
## race_ethnicity[1,3,5]
## race_ethnicity[1,4,5]
## race_ethnicity[2,4,5]
## race_ethnicity[5,6]
## race_ethnicity[6,7]
## religious_affil[6] *
## religious_affil[2]
## religious_affil[8] **
## religious_affil[9]
## religious_affil[4] *
## religious_affil[1]
## religious_affil[5]
## religious_affil[3]
## religious_affil[7,8]
## religious_affil[1,2]
## religious_affil[1,6]
## religious_affil[1,7]
## religious_affil[2,7]
## religious_affil[4,7]
## religious_affil[6,9]
## religious_affil[8,9]
## religious_serv
## political_ideology
## education
## conclusion[does not cause harm]:part_values[public health] *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.164 on 750 degrees of freedom
## (187 observations deleted due to missingness)
## Multiple R-squared: 0.2364, Adjusted R-squared: 0.1855
## F-statistic: 4.645 on 50 and 750 DF, p-value: < 2.2e-16
eb_tbl = list(base = model_b, interaction = model_eb, demo = model_eb1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
eb_tbl
| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 | 5.3 | 4.7, 5.9 | <0.001 |
| conclusion | |||||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 | -0.73 | -1.1, -0.38 | <0.001 |
| part_values | |||||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | 0.20 | -0.09, 0.49 | 0.2 | |||
| conclusion * part_values | |||||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | -0.46 | -0.86, -0.07 | 0.022 | |||
| age | 0.00 | 0.00, 0.01 | 0.4 | ||||||
| religious_serv | -0.01 | -0.08, 0.05 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.03 | 0.4 | ||||||
| education | -0.04 | -0.21, 0.13 | 0.6 | ||||||
| R² | 0.148 | 0.176 | 0.236 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.147 | 0.173 | 0.186 | ||||||
| Statistic | 171 | 59.9 | 4.64 | ||||||
| p-value | <0.001 | <0.001 | <0.001 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(eb_tbl, here(out_dir, '03_eb_tbl'))
emad_df |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, pa_mean)) +
geom_boxplot() +
facet_wrap(vars(part_values))
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, meti_mean)) +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
facet_wrap(vars(part_values)) +
labs(x = 'scientist conclusion: BPA ...',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_conclusion_part.png'),
height = 3, width = 6, scale = 1,
bg = 'white')
dag |>
add_arrows(c('part_values -> disclosure_x_part_values <- disclosure',
'disclosure_x_part_values -> METI',
'disclosure -> METI')) |>
plot_adjustments('disclosure_x_part_values')
model_ec_emad = lm(pa_mean ~ disclosure*part_values, data = emad_df)
summary(model_ec_emad)
##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.4090 -1.0042 0.1387 1.1446 2.1387
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.35272 0.18476 28.971
## disclosure[TRUE] -0.32001 0.22784 -1.405
## part_values[public health] 0.05629 0.23878 0.236
## disclosure[TRUE]:part_values[public health] -0.22770 0.29095 -0.783
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.161
## part_values[public health] 0.814
## disclosure[TRUE]:part_values[public health] 0.434
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.466 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.02353, Adjusted R-squared: 0.01758
## F-statistic: 3.953 on 3 and 492 DF, p-value: 0.008371
lm(pa_mean ~ disclosure*part_values+
sex + ideology + educatio + age, data = emad_df) |>
summary()
##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values + sex + ideology +
## educatio + age, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.2393 -0.9427 0.1744 1.1730 2.2864
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.227099 0.334903 15.608
## disclosure[TRUE] -0.323021 0.228681 -1.413
## part_values[public health] 0.003625 0.243423 0.015
## sex 0.025026 0.134675 0.186
## ideology 0.007676 0.042153 0.182
## educatio -0.084100 0.064652 -1.301
## age 0.069062 0.031725 2.177
## disclosure[TRUE]:part_values[public health] -0.256452 0.291972 -0.878
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.158
## part_values[public health] 0.988
## sex 0.853
## ideology 0.856
## educatio 0.194
## age 0.030 *
## disclosure[TRUE]:part_values[public health] 0.380
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.459 on 484 degrees of freedom
## (6 observations deleted due to missingness)
## Multiple R-squared: 0.03626, Adjusted R-squared: 0.02232
## F-statistic: 2.601 on 7 and 484 DF, p-value: 0.01212
model_ec = lm(meti_mean ~ disclosure*part_values, data = dataf)
summary(model_ec)
##
## Call:
## lm(formula = meti_mean ~ disclosure * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9023 -0.9061 0.0977 1.0263 2.0977
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.01557 0.14634 34.273
## disclosure[TRUE] 0.04464 0.18767 0.238
## part_values[public health] 0.07453 0.17265 0.432
## disclosure[TRUE]:part_values[public health] -0.23243 0.21762 -1.068
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.812
## part_values[public health] 0.666
## disclosure[TRUE]:part_values[public health] 0.286
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.292 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.004245, Adjusted R-squared: 0.0006885
## F-statistic: 1.194 on 3 and 840 DF, p-value: 0.3111
plot_residuals(model_ec)
## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_ec, ':')
plot_estimate(list(base = model_c, interaction = model_ec),
str_detect(term, 'disclosure'))
plot_predictions(model_ec, c('disclosure', 'part_values'),
interaction_ci = TRUE)
model_ec1 = lm(meti_mean ~ disclosure * part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
ec_tbl = list(base = model_c, interaction = model_ec, demographics = model_ec1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
ec_tbl
| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.1 | 4.9, 5.2 | <0.001 | 5.0 | 4.7, 5.3 | <0.001 | 4.9 | 4.3, 5.6 | <0.001 |
| disclosure | |||||||||
| disclosure[TRUE] | -0.11 | -0.28, 0.06 | 0.2 | 0.04 | -0.32, 0.41 | 0.8 | 0.05 | -0.34, 0.43 | 0.8 |
| part_values | |||||||||
| part_values[public health] | 0.07 | -0.26, 0.41 | 0.7 | 0.14 | -0.23, 0.51 | 0.5 | |||
| disclosure * part_values | |||||||||
| disclosure[TRUE] * part_values[public health] | -0.23 | -0.66, 0.19 | 0.3 | -0.29 | -0.74, 0.15 | 0.2 | |||
| age | 0.00 | 0.00, 0.01 | 0.5 | ||||||
| religious_serv | 0.02 | -0.06, 0.09 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.04 | 0.5 | ||||||
| education | -0.07 | -0.26, 0.11 | 0.4 | ||||||
| R² | 0.002 | 0.004 | 0.071 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.001 | 0.001 | 0.009 | ||||||
| Statistic | 1.60 | 1.19 | 1.15 | ||||||
| p-value | 0.2 | 0.3 | 0.2 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(ec_tbl, here(out_dir, '03_ec_tbl'))
dataf |>
filter(!is.na(part_values)) |>
ggplot(aes(disclosure, meti_mean)) +
geom_boxplot() +
# geom_beeswarm(alpha = .25) +
facet_wrap(vars(part_values))